home *** CD-ROM | disk | FTP | other *** search
Wrap
' Version 2.33 - 24.11.94 version$="2.33" ~FRE(0) ' ON BREAK GOSUB breakout ON ERROR GOSUB error_trapping ' initialize cmd_line parse_ctl_file ' logit!=FALSE add_header add_magic @clear paths_to_search logo prep_pack took_how_long finish(0) > PROCEDURE initialize CLS HIDEM t%=TIMER today%=GEMDOS(42) max%=0 min%=99999999 md%=0 mf%=0 lc%=6 tp%=10 tmpgrp%=10 tc%=0 numareas&=0 gtp%=50 number_areas%=250 max_files%=2000 gnum%=25 lf$=CHR$(10) rn!=TRUE grn!=TRUE flname$=SPACE$(13) fn$=SPACE$(13) flsize$=SPACE$(7) fldate$=SPACE$(9) ctl_file$="LISTER.CTL" search_file$="SEARCH.CTL" fdata$="FILES.BBS" drv$=CHR$(GEMDOS(25)+65) origpath$=drv$+":"+DIR$(0)+"\" DIM gnw!(gnum%),keep!(gnum%),mt%(gnum%),totcnt%(gnum%),ntotcnt%(gnum%),totfilesize%(gnum%),totnfilesize%(gnum%),numareas%(number_areas%),top%(tp%-1) DIM lzh!(gnum%),arc!(gnum%),zip!(gnum%),nh!(gnum%),newhead!(gnum%),g_max%(gnum%),g_min%(gnum%) DIM g_allname$(gnum%),g_newname$(gnum%),g_arcpath$(gnum%),group$(gnum%),g_magic$(gnum%) DIM g_allfile$(gnum%),g_newfile$(gnum%),g_allpack$(gnum%),g_newpack$(gnum%),gtp%(gnum%) DIM g_header$(gnum%),g_newheader$(gnum%),top$(tp%-1),g_bigfile$(gnum%),g_smallfile$(gnum%),outtp$(gnum%) DIM g_top%(gtp%-1,gnum%),g_top$(gtp%-1,gnum%),mv!(gnum%),tt!(gnum%),tc%(gnum%),otp!(gnum%) DIM topsize$(tp%-1),topdesc$(tp%-1),g_topsize$(gtp%-1,gnum%),g_topdesc$(gtp%-1,gnum%),toptitle$(gnum%) DIM btl$(3),btr$(3),bbl$(3),bbr$(3),bse$(3),be$(3) DIM besl$(3),besr$(3),bts$(3),bbs$(3),bcs$(3) DIM r$(3),g$(3),b$(3),br$(3),bg$(3),bc$(3) ' ' Ascii screen. ' btl$(0)="+" btr$(0)="+" bbl$(0)="+" bbr$(0)="+" bse$(0)="-" be$(0)="|" besl$(0)="+" besr$(0)="+" bts$(0)="+" bbs$(0)="+" bcs$(0)="+" g$(0)="" r$(0)="" b$(0)="" br$(0)="" bg$(3)="" bc$(0)="" ' ' Mono screen. ' btl$(1)="+" btr$(1)="+" bbl$(1)="+" bbr$(1)="+" bse$(1)="-" be$(1)="|" besl$(1)="+" besr$(1)="+" bts$(1)="+" bbs$(1)="+" bcs$(1)="+" g$(1)="" r$(1)="" b$(1)="" br$(1)="p" bg$(1)="p" bc$(1)="q" ' ' Colour screen. ' btl$(2)="+" btr$(2)="+" bbl$(2)="+" bbr$(2)="+" bse$(2)="-" be$(2)="|" besl$(2)="+" besr$(2)="+" bts$(2)="+" bbs$(2)="+" bcs$(2)="+" r$(2)="b1" ! Red text g$(2)="b2" ! Blue text b$(2)="b3" ! Black text br$(2)="c1" ! Red background bg$(2)="c2" ! Blue background bc$(2)="c0" ! White background ' ' Ansi screen output ' btl$(3)="É" btr$(3)="»" bbl$(3)="È" bbr$(3)="¼" bse$(3)="Í" be$(3)="º" besl$(3)="Ì" besr$(3)="¹" bts$(3)="Ë" bbs$(3)="Ê" bcs$(3)="Î" r$(3)="" g$(3)="" b$(3)="" br$(3)="" bg$(3)="" bc$(3)="" ' IF XBIOS(4)=2 DEFFILL 1,1 PBOX 0,0,639,62 th&=32 th2&=41 ELSE DEFFILL 2,1 PBOX 0,0,639,31 th&=18 th2&=26 ENDIF ' DEFTEXT 1,0,0,13 TEXT 144,th&," LiSTer v"+version$+" (c)1993/94 by Robert Darling. " DEFTEXT 1,0,0,6 TEXT 144,th2&," For QuickBBS, ProBBS, and Octopus Systems. " RETURN > PROCEDURE parse_ctl_file ' IF EXIST(ctl_file$) OPEN "i",#1,ctl_file$ DIM lster$(1000) n&=0 RECALL #1,lster$(),-1,n% CLOSE #1 ELSE display(ctl_file$+" not found. Check it out!") PAUSE 100 END ENDIF ' display("Parsing control file...") FOR c%=0 TO n% lster$(c%)=TRIM$(lster$(c%)) NEXT c% ' FOR c%=0 TO n% IF LEFT$(UPPER$(lster$(c%)),7)="INCDATE" fd!=TRUE ' Include date ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="INCSIZE" fs!=TRUE ' Include size ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="INCSTAT" stat!=TRUE ' Include stats ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="ARCLIST" arc!=TRUE ' ARC the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="LZHLIST" lzh!=TRUE ' LZH the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="ZIPLIST" zip!=TRUE ' ZIP the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="KEEPLIST" keep!=TRUE ' Don't delete the ascii lists! ENDIF ' IF LEFT$(UPPER$(lster$(c%)),15)="USE GROUPS ONLY" grp_only!=TRUE ' Don't delete the ascii lists! ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="LOGFILE" logit!=TRUE IF LEN(lster$(c%))=7 logpath$="LISTER.LOG" ELSE a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND logpath$=@fullpath$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))+"LISTER.LOG" l_drv$=LEFT$(logpath$,1) ENDIF ENDIF ' IF LEFT$(UPPER$(lster$(c%)),12)="MISSING-INFO" mi!=TRUE ENDIF IF LEFT$(UPPER$(lster$(c%)),7)="FIXDATE" fixdate!=TRUE ENDIF IF LEFT$(UPPER$(lster$(c%)),6)="LATEST" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND numdays%=VAL(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) olddate%=GEMDOS(42)-numdays% ' How many days to cover in the newfiles list. Also adds the * to ' new files listed in the Allfiles list. ENDIF IF LEFT$(UPPER$(lster$(c%)),7)="ALLNAME" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND allname$=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) IF INSTR(RIGHT$(allname$,4),".")=0 allpack$=allname$ allname$=allname$+".TXT" ELSE allpack$=UPPER$(LEFT$(allname$,INSTR(allname$,".")-1)) ENDIF ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="NEWNAME" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND newname$=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) IF INSTR(RIGHT$(newname$,4),".")=0 newpack$=newname$ newname$=newname$+".TXT" ELSE newpack$=UPPER$(LEFT$(newname$,INSTR(newname$,".")-1)) ENDIF nw!=TRUE ' Make a Newfiles list too. ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="KEEPPATH" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND arcpath$=@fullpath$(UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1))) allfile$=arcpath$+allname$ newfile$=arcpath$+newname$ ' This is where the lists are saved. ENDIF IF LEFT$(UPPER$(lster$(c%)),6)="HEADER" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND header$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1) ENDIF IF LEFT$(UPPER$(lster$(c%)),9)="NEWHEADER" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND newheader$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1) newhead!=TRUE ENDIF IF LEFT$(UPPER$(lster$(c%)),5)="MAGIC" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND magic$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1) ENDIF IF LEFT$(UPPER$(lster$(c%)),6)="FOOTER" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND footer$=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1) ENDIF IF LEFT$(UPPER$(lster$(c%)),7)="PACKARC" a%=RINSTR(lster$(c%)," ") packarc$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%) ENDIF IF LEFT$(UPPER$(lster$(c%)),7)="PACKLZH" a%=RINSTR(lster$(c%)," ") packlzh$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%) ENDIF IF LEFT$(UPPER$(lster$(c%)),7)="PACKZIP" a%=RINSTR(lster$(c%)," ") packzip$=MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),5)="GROUP" @group_data ENDIF ' IF LEFT$(UPPER$(lster$(c%)),6)="PROBBS" probbs!=TRUE fdata$="FILES.DAT" ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="OCTOPUS" octopus!=TRUE ENDIF ' IF LEFT$(UPPER$(lster$(c%)),5)="AREAS" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND number_areas%=VAL(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),6)="TOPTEN" topten!=TRUE a%=RINSTR(lster$(c%)," ") bracket1$=MID$(lster$(c%),a%+1,1) bracket2$=MID$(lster$(c%),a%+2,1) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="PROCOUNT" a%=RINSTR(lster$(c%)," ") bracket1$=MID$(lster$(c%),a%+1,1) bracket2$=MID$(lster$(c%),a%+2,1) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="TOPTITLE" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND toptitle$=TRIM$(LEFT$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1),74)) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="LISTTOP" a%=INSTR(lster$(c%),"$") tp%=VAL(MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%)) ' IF tp%=0 tp%=10 ENDIF ' IF tp%>50 tp%=50 ENDIF ' @redimension ENDIF ' IF LEFT$(UPPER$(lster$(c%)),12)="WRITE TOPTEN" a%=RINSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND outtp$=@fullpath$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) outtp$=outtp$+"TOP_"+STR$(tp%) IF topten! otp!=TRUE ENDIF ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="FOURTOPS" fourtops!=TRUE ENDIF ' IF LEFT$(UPPER$(lster$(c%)),4)="OMIT" @omit_files ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="SHOWMEM" smem!=TRUE ENDIF ' IF LEFT$(UPPER$(lster$(c%)),5)="DEBUG" debug!=TRUE dblog$="DEBUG.LOG" display("Debug mode activated.") display("") IF EXIST(dblog$)=0 MODE 3 OPEN "o",#2,dblog$ PRINT #2,"--------------------------------------------------" PRINT #2,"LiSTer "+version$+" Debug Log - Created on "+MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2)+" at "+TIME$ PRINT #2,"--------------------------------------------------" PRINT #2 CLOSE #2 ENDIF ENDIF NEXT c% RETURN > PROCEDURE redimension ERASE top%(),top$(),topsize$(),topdesc$() DIM top%(tp%-1),top$(tp%-1),topsize$(tp%-1),topdesc$(tp%-1) RETURN ' ' Text files to be included in lists. ' > PROCEDURE add_header IF grp_only! GOTO group_headers ENDIF ' IF EXIST(header$) DIM head$(300) OPEN "I",#1,header$ RECALL #1,head$(),-1,header% CLOSE #1 ' OPEN "O",#1,allname$ STORE #1,head$(),header% CLOSE #1 ENDIF ' IF newhead! AND nw! IF EXIST(newheader$) DIM newhead$(300) OPEN "i",#1,newheader$ RECALL #1,newhead$(),-1,header% CLOSE #1 nh!=TRUE !Alternative header file for newfiles list. ENDIF ENDIF IF nw! OPEN "O",#1,newname$ IF nh! STORE #1,newhead$(),header% ELSE STORE #1,head$(),header% ENDIF CLOSE #1 ENDIF ' ERASE head$(),newhead$() ~FRE(0) ' group_headers: ' ' Write headers for other lists if needed. ' IF grp_activate! @group_headers ENDIF RETURN > PROCEDURE add_magic IF grp_only! GOTO group_magics ENDIF ' IF EXIST(magic$) DIM mag$(300) OPEN "I",#1,magic$ RECALL #1,mag$(),-1,mag% CLOSE #1 IF EXIST(allname$) OPEN "a",#1,allname$ STORE #1,mag$(),mag% CLOSE #1 ELSE OPEN "o",#1,allname$ STORE #1,mag$(),mag% CLOSE #1 ENDIF ' IF nw! IF EXIST(newname$) OPEN "a",#1,newname$ STORE #1,mag$(),mag% CLOSE #1 ELSE OPEN "a",#1,newname$ STORE #1,mag$(),mag% CLOSE #1 ENDIF ENDIF ENDIF ' ERASE mag$() ~FRE(0) ' group_magics: ' ' Write group magics if required. ' IF grp_activate! @group_magics ENDIF RETURN > PROCEDURE add_footer IF EXIST(footer$) AND ft!=FALSE DIM foot$(300) OPEN "I",#2,footer$ RECALL #2,foot$(),-1,foot% CLOSE #2 ft!=TRUE ENDIF ' IF all! PRINT #1,"" STORE #1,foot$(),foot% ENDIF ' IF newfoot! PRINT #1,"" STORE #1,foot$(),foot% ENDIF RETURN ' ' Creation of actual filelists starts here! ' > PROCEDURE paths_to_search ' Provides a list of the paths to be searched for files. @show_mem(STR$(FRE())) ' IF EXIST(search_file$) OPEN "i",#1,search_file$ DIM lst$(number_areas%) x%=0 RECALL #1,lst$(),-1,x% CLOSE #1 ELSE display("SEARCH.CTL not found. Check it out!") PAUSE 100 END ENDIF ' ' lst$(x%) now contains the list of areas to search. ' n&=0 REPEAT an&=n&+1 title$="" group$="" ' ' Get path to files... ' spc&=INSTR(lst$(n&)," ") ! Look for first space. IF spc&=0 AND LEN(lst$(n&))>0 spc&=LEN(lst$(n&))+1 ENDIF path$=LEFT$(lst$(n&),spc&-1) backslash(path$) ' IF octopus! ' ' Get area title (for Octopus lists) ' st&=INSTR(lst$(n&),"[") end&=INSTR(lst$(n&),"]") IF st&>0 AND end&>0 title$=MID$(lst$(n&),st&+1,end&-st&-1) ENDIF ENDIF ' IF probbs! ' ' Get area title (for ProBBS lists) ' st&=INSTR(lst$(n&),"[") end&=INSTR(lst$(n&),"]") IF st&>0 AND end&>0 title$=MID$(lst$(n&),st&+1,end&-st&-1) ENDIF ' ' Get path to FILES.DAT if different from file area (for ProBBS) ' st2&=INSTR(lst$(n&),"{") end2&=INSTR(lst$(n&),"}") IF st2&>0 AND end2&>0 dat_path$=MID$(lst$(n&),st2&+1,end2&-st2&-1) backslash(dat_path$) dp!=TRUE ELSE dat_path$=path$ dp!=FALSE ENDIF ' ENDIF ' ' Get Group info if available. ' grp_st&=INSTR(lst$(n&),"%") IF grp_st&>0 grp_end&=INSTR(lst$(n&)," ",grp_st&) IF grp_end&=0 grp_end&=LEN(lst$(n&))+1 ENDIF group$=MID$(lst$(n&),grp_st&+1,grp_end&-grp_st&) ENDIF ' IF grp_only! AND group$="" INC an& GOTO miss_area ENDIF ' IF spc&>0 IF EXIST(path$+fdata$) OR EXIST(dat_path$+fdata$) @show_mem(STR$(FRE())) catalogue(path$+"*.*") flbbs!=FALSE ERASE fbbs$() ~FRE(0) @show_mem(STR$(FRE())) IF i%=0 OR cnt%=0 INC an& GOTO miss_area ELSE INC an& output_file_lists @show_mem(STR$(FRE())) ENDIF ENDIF ENDIF miss_area: INC n& UNTIL LEN(lst$(n&))=0 ' ' Clean up memory a bit, make more available. ' @show_mem(STR$(FRE())) ERASE info$(),info_new$(),fname$(),fsize$(),fdate%(),lst$(),title$() ~FRE(0) @show_mem(STR$(FRE())) RETURN > PROCEDURE catalogue(search$) display("Searching: "+search$) IF debug! blank!=TRUE debug("Searching "+search$) blank!=FALSE ENDIF cnt%=0 cnt2%=0 mf%=0 md%=0 areafsize%=0 nareafsize%=0 logcnt&=0 ERASE info$(),info_new$(),fname$(),fsize$(),fdate%() DIM info$(max_files%),info_new$(max_files%),fname$(max_files%),fsize$(max_files%),fdate%(max_files%) bufadr%=FGETDTA() search%=FSFIRST(search$,&X100001) i%=0 DO UNTIL search% fname$(i%)=CHAR{bufadr%+30} EXIT IF fname$(i%)="" fsize$(i%)=STR$({bufadr%+26}) fdate%(i%)=CARD{bufadr%+24} INC i% search%=FSNEXT() LOOP IF i%=0 GOTO go_back ENDIF DEC i% FOR j%=0 TO i% IF debug! debug("Filename: "+fname$(j%)) ENDIF IF fname$(j%)<>"FILES.BBS" AND fname$(j%)<>"FILES.BAK" AND fname$(j%)<>"FILES.DAT" AND fname$(j%)<>"FILES.HAS" AND fname$(j%)<>"FILES.BAC" ' IF fdate%(j%)>=olddate% AND fdate%<=today% fnew!=TRUE ENDIF ' mx%=VAL(fsize$(j%)) IF mx%>max% SWAP max%,mx% bigfile$=fname$(j%) IF grp_activate! AND group$<>"" @g_bigfile(bigfile$,max%) ENDIF ENDIF ' IF mx%>0 AND mx%<min% SWAP min%,mx% smallfile$=fname$(j%) IF grp_activate! AND group$<>"" @g_smallfile(smallfile$,min%) ENDIF ENDIF ' make_date(fdate%(j%)) make_line(fname$(j%),fsize$(j%),fdate$) INC cnt% ENDIF NEXT j% go_back: RETURN > PROCEDURE make_line(fname$,fsize$,fdate$) LSET flname$=fname$ RSET flsize$=fsize$ LSET fldate$=fdate$ IF fnew! MID$(fldate$,9,1)="*" ENDIF ' IF fs! AND fd! fl&=46 areafsize%=areafsize%+VAL(fsize$) fldesc(fname$) info$(cnt%)=flname$+flsize$+" "+fldate$+" "+fldesc$ IF nw! AND fnew! nareafsize%=nareafsize%+VAL(fsize$) info_new$(cnt2%)=info$(cnt%) MID$(info_new$(cnt2%),30,1)=" " INC cnt2% ENDIF ' ELSE IF fs! fl&=56 areafsize%=areafsize%+VAL(fsize$) fldesc(fname$) info$(cnt%)=flname$+flsize$+" "+fldesc$ IF nw! AND fnew! nareafsize%=nareafsize%+VAL(fsize$) info_new$(cnt2%)=info$(cnt%) INC cnt2% ENDIF ' ELSE IF fd! fl&=53 areafsize%=areafsize%+VAL(fsize$) fldesc(fname$) info$(cnt%)=flname$+" "+fldate$+" "+fldesc$ IF nw! AND fnew! nareafsize%=nareafsize%+VAL(fsize$) info_new$(cnt2%)=info$(cnt%) MID$(info_new$(cnt2%),24,1)=" " INC cnt2% ENDIF ' ELSE fl&=64 areafsize%=areafsize%+VAL(fsize$) fldesc(fname$) info$(cnt%)=flname$+fldesc$ IF nw! AND fnew! nareafsize%=nareafsize%+VAL(fsize$) info_new$(cnt2%)=info$(cnt%) INC cnt2% ENDIF ENDIF fnew!=FALSE RETURN > PROCEDURE fldesc(fname$) ' ' If info for area not in memory.... load it! ' IF flbbs!=FALSE DIM fbbs$(max_files%) IF probbs! ERASE dl%() DIM dl%(max_files%) @probbs_title_and_data ELSE IF octopus! @octopus_title_and_data ELSE @qbbs_title_and_data ENDIF flbbs!=TRUE ENDIF ' find&=0 f!=FALSE fldesc$="" ' DO ' IF LEN(TRIM$(fbbs$(find&)))<13 IF INSTR(LEFT$(fbbs$(find&),LEN(fname$)),fname$)>0 INC md% IF debug! debug("File description missing for "+fname$) ENDIF fldesc$="*** File Description Missing ***" @logit(path$+fname$+" has no description in "+fdata$) f!=TRUE ENDIF ' ELSE IF INSTR(LEFT$(fbbs$(find&),LEN(fname$)),fname$)>0 a|=INSTR(fbbs$(find&)," ") WHILE MID$(fbbs$(find&),a|,1)=" " INC a| WEND fldesc$=RIGHT$(fbbs$(find&),LEN(fbbs$(find&))-a|+1) ' IF topten! AND INSTR(omitfile$,fname$(j%))=0 IF probbs! fnum%=dl%(find&) @pro_topten(fname$,fnum%) ELSE @topten(LEFT$(fldesc$,10),fname$) ENDIF IF group$<>"" AND fnum%>0 AND grp_activate! @group_topten ENDIF ENDIF ' IF probbs! IF dl%(find&)>0 fldesc$=bracket1$+STR$(dl%(find&))+bracket2$+" "+fldesc$ ENDIF ENDIF ' format_desc(fldesc$) f!=TRUE ' ENDIF ' INC find& LOOP UNTIL find&=x% OR f! ' IF fldesc$="" IF debug! debug("No entry found for "+fname$) ENDIF fldesc$="*** Description not available ***" INC mf% @logit(path$+fdata$+" contains no entry for "+fname$) ENDIF ' RETURN > PROCEDURE qbbs_title_and_data OPEN "i",#1,path$+fdata$ x%=0 RECALL #1,fbbs$(),-1,x% CLOSE #1 ' ERASE title$() ~FRE(0) DIM title$(20) tcnt%=0 ' WHILE INSTR(LEFT$(fbbs$(tcnt%),9),".")=0 AND fbbs$(tcnt%)<>"" title$(tcnt%)=fbbs$(tcnt%) INC tcnt% WEND ' IF tcnt%=0 title$="File Area Number "+STR$(an&) l|=LEN(title$) title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~") title$(1)=SPACE$((80-l|)/2-4)+"** "+title$+" **" title$(2)=title$(0) title$(3)="" tcnt%=3 ENDIF IF fbbs$(tcnt%)<>"" DEC tcnt% ENDIF RETURN > PROCEDURE probbs_title_and_data ' IF dp! OPEN "r",#1,dat_path$+fdata$,314 ELSE OPEN "r",#1,path$+fdata$,314 ENDIF ' nr%=LOF(#1)/314 FIELD #1,13 AS fnm$,244 AS fd$,55 AS void$,2 AT(*dl&) FOR x%=1 TO nr% GET #1,x% LSET fn$=CHAR{V:fnm$} fbbs$(x%-1)=TRIM$(CHAR{V:fd$}) IF INSTR(fbbs$(x%-1),bracket1$)=1 AND INSTR(fbbs$(x%-1),bracket2$)<5 x2%=INSTR(fbbs$(x%-1),bracket2$) fbbs$(x%-1)=MID$(fbbs$(x%-1),x2%+2,LEN(fbbs$(x%-1))-(x2%+2)) ENDIF fbbs$(x%-1)=fn$+fbbs$(x%-1) dl%(x%-1)=dl& NEXT x% CLOSE #1 ' ERASE title$() ~FRE(0) DIM title$(20) IF title$<>"" l|=LEN(title$) title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~") title$(1)=SPACE$((80-l|)/2-4)+"** "+title$+" **" title$(2)=title$(0) title$(3)="" tcnt%=3 ELSE title$="File Area Number "+STR$(an&) l|=LEN(title$) title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~") title$(1)=SPACE$((80-l|)/2-4)+"** "+title$+" **" title$(2)=title$(0) title$(3)="" tcnt%=3 ENDIF RETURN > PROCEDURE octopus_title_and_data OPEN "i",#1,path$+fdata$ x%=0 RECALL #1,fbbs$(),-1,x% CLOSE #1 ' ERASE title$() ~FRE(0) DIM title$(20) ' IF title$<>"" l|=LEN(title$) title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~") title$(1)=SPACE$((80-l|)/2-4)+"** "+title$+" **" title$(2)=title$(0) title$(3)="" tcnt%=3 ELSE title$="File Area Number "+STR$(an&) l|=LEN(title$) title$(0)=SPACE$((80-l|)/2-4)+STRING$(l|+8,"~") title$(1)=SPACE$((80-l|)/2-4)+"** "+title$+" **" title$(2)=title$(0) title$(3)="" tcnt%=3 ENDIF RETURN > PROCEDURE format_desc(VAR fldesc$) LOCAL a$ IF debug! debug("File description found for "+fname$) ENDIF ' WHILE LEN(fldesc$)>fl& blank%=RINSTR(fldesc$," ",fl&+1) IF blank%<fl&/3 blank%=fl&+1 DO DEC blank% a$=MID$(fldesc$,blank%,1) EXIT IF ASC(a$)<48 OR ASC(a$)>57 AND ASC(a$)<65 OR ASC(a$)>122 LOOP ENDIF ' tmpdesc$=tmpdesc$+LEFT$(fldesc$,fl&)+CHR$(13)+CHR$(10)+SPACE$(31-(fl&-46)) ' fldesc$=RIGHT$(fldesc$,LEN(fldesc$)-fl&) ' ELSE tmpdesc$=tmpdesc$+LEFT$(fldesc$,blank%)+CHR$(13)+CHR$(10)+SPACE$(31-(fl&-46)) fldesc$=RIGHT$(fldesc$,LEN(fldesc$)-blank%) ' ENDIF WEND fldesc$=tmpdesc$+fldesc$ tmpdesc$="" RETURN > PROCEDURE output_file_lists ' ' Sort lists before writing. ' IF cnt%>0 QSORT info$(),cnt% IF cnt2%>0 QSORT info_new$(),cnt2% ENDIF ENDIF ' IF grp_only! GOTO group_output ENDIF ' IF rn! make_date(GEMDOS(42)) IF EXIST(allname$) OPEN "a",#1,allname$ ELSE OPEN "o",#1,allname$ ENDIF PRINT #1,"List created : ";fdate$ PRINT #1,"Files marked with a '*' are new in the last ";STR$(numdays%);" days." PRINT #1,"" CLOSE #1 rn!=FALSE ENDIF ' IF EXIST(allname$) OPEN "a",#1,allname$ update_list1 CLOSE #1 ENDIF ' IF cnt2%>0 IF EXIST(newname$) OPEN "a",#1,newname$ update_list2 CLOSE #1 ENDIF ENDIF ' INC numareas& mt%=mt%+md%+mf% totcnt%=totcnt%+cnt% ntotcnt%=ntotcnt%+cnt2% totfilesize%=totfilesize%+areafsize% totnfilesize%=totnfilesize%+nareafsize% ' group_output: IF grp_activate! AND group$<>"" @group_output_file_lists ENDIF RETURN > PROCEDURE logo ' IF totfilesize%>=1024 asz%=INT(totfilesize%/1024) asz$=" Kbytes." ELSE asz%=INT(totfilesize%) asz$=" bytes" ENDIF ' IF totcnt%>0 avsz%=INT(totfilesize%/totcnt%) IF avsz%>=1024 avsz%=avsz%/1024 avsz$=" Kbytes." ELSE avsz$=" bytes." ENDIF ENDIF ' IF totnfilesize%>=1024 nsz%=INT(totnfilesize%/1024) nsz$=" Kbytes." ELSE nsz%=INT(totnfilesize%) nsz$=" bytes" ENDIF ' IF ntotcnt%>0 navsz%=INT(totnfilesize%/ntotcnt%) IF navsz%>=1024 navsz%=navsz%/1024 navsz$=" Kbytes." ELSE navsz$=" bytes." ENDIF ENDIF ' fttop$=SPACE$(13) ftsize$=SPACE$(7) ftdesc$=SPACE$(36) bord$=" "+STRING$(78,"=") logo$="List generated by BBS LiSTer v"+version$+" (c)1993/94 by Robert Darling." logo$=SPACE$((80-LEN(logo$))/2)+logo$ large$="Largest file is "+bigfile$+" at "+STR$(max%)+" bytes." small$="Smallest file is "+smallfile$+" at "+STR$(min%)+" bytes." pad$="Total file size : "+STR$(asz%)+asz$ pad%=(80-LEN(pad$))/2 large%=(80-LEN(large$))/2 large$=SPACE$(large%)+large$ small$=SPACE$(large%)+small$ ' IF grp_only! GOTO group_finish ENDIF ' IF EXIST(allname$) all!=TRUE OPEN "a",#1,allname$ IF stat! PRINT #1,bord$ PRINT #1 PRINT #1,SPACE$(pad%);"Total files available: ";totcnt% PRINT #1,SPACE$(pad%);"Total file size : ";asz%;asz$ PRINT #1,SPACE$(pad%);"Number of areas : ";numareas& IF avsz%>0 PRINT #1,SPACE$(pad%);"Average file length : ";avsz%;avsz$ ENDIF IF mi! PRINT #1,SPACE$(pad%);"Descriptions missing : ";mt% ENDIF PRINT #1 PRINT #1,large$ PRINT #1,small$ IF topten! PRINT #1 PRINT #1,SPACE$(16);"Top ";STR$(tp%);" most popular files on this system are..." PRINT #1 PRINT #1,SPACE$(20);"Position Filename Number of d/l's" PRINT #1 FOR i%=0 TO tc% EXIT IF top$(i%)="" LSET fttop$=top$(i%) PRINT #1,SPACE$(19);STR$(i%+1,6);". ";fttop$;" ";STR$(top%(i%),6) NEXT i% PRINT #1 ENDIF PRINT #1,bord$ ENDIF add_footer IF ft! PRINT #1 ENDIF PRINT #1,logo$ CLOSE #1 all!=FALSE ENDIF ' IF otp! @clear IF fourtops! tx%=3 ELSE tx%=0 ENDIF ' FOR b%=0 TO tx% ' IF b%=0 ! Straight ASCII output ext$=".ASC" ELSE IF b%=1 ! Mono output ext$=".VTM" ELSE IF b%=2 ! Colour output ext$=".VTC" ELSE ext$=".ANS" ! ANSI output ENDIF hdl$=" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" No. "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Filename "+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Size "+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" DL'd "+bc$(b%)+g$(b%)+be$(b%)+b$(b%) hdl$=hdl$+" "+br$(b%)+" Description "+bc$(b%)+SPACE$(24)+g$(b%)+be$(b%)+b$(b%) tsepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bts$(b%)+STRING$(14,bse$(b%))+bts$(b%)+STRING$(9,bse$(b%))+bts$(b%)+STRING$(6,bse$(b%))+bts$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%) sepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bcs$(b%)+STRING$(14,bse$(b%))+bcs$(b%)+STRING$(9,bse$(b%))+bcs$(b%)+STRING$(6,bse$(b%))+bcs$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%) ' IF toptitle$="" topadd$=SPACE$(11)+"The Top "+STR$(tp%,2)+" Chart - created on "+DATE$+" at "+TIME$+SPACE$(11) ELSE IF LEN(toptitle$) MOD 2=1 padit|=1 ELSE padit|=0 ENDIF spc%=(74-LEN(toptitle$))/2 spc2%=spc%+padit| topadd$=SPACE$(spc%)+toptitle$+SPACE$(spc2%) ENDIF ' topper$=" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+topadd$+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%) display("Writing "+outtp$+ext$) OPEN "o",#1,outtp$+ext$ PRINT #1," ";g$(b%);btl$(b%);STRING$(76,bse$(b%));btr$(b%);b$(b%) PRINT #1,topper$ PRINT #1,tsepl$ PRINT #1,hdl$ PRINT #1,sepl$ FOR i%=0 TO tc% EXIT IF top$(i%)="" LSET fttop$=top$(i%) RSET ftsize$=topsize$(i%) LSET ftdesc$=topdesc$(i%) PRINT #1," ";g$(b%);be$(b%);r$(b%);STR$(i%+1,3);". ";g$(b%);be$(b%);b$(b%);" ";fttop$;g$(b%);be$(b%);" ";r$(b%);ftsize$;b$(b%);" ";g$(b%);be$(b%);" ";r$(b%);STR$(top%(i%),4);g$(b%);" ";be$(b%);b$(b%);" ";ftdesc$;" ";g$(b%);be$(b%);b$(b%) NEXT i% PRINT #1," ";g$(b%);besl$(b%);STRING$(5,bse$(b%));bbs$(b%);STRING$(14,bse$(b%));bbs$(b%);STRING$(9,bse$(b%));bbs$(b%);STRING$(6,bse$(b%));bbs$(b%);STRING$(38,bse$(b%));besr$(b%);b$(b%) PRINT #1," ";g$(b%);be$(b%);b$(b%);SPACE$(6);"Top ";STR$(tp%,2);" produced by ";br$(b%);" LiSTer V";version$;" ";bc$(b%);" (c)1993/94 by Robert Darling.";SPACE$(7);g$(b%);be$(b%);b$(b%) PRINT #1," ";g$(b%);bbl$(b%);STRING$(76,bse$(b%));bbr$(b%);b$(b%) CLOSE #1 NEXT b% ENDIF ' IF EXIST(newname$) AND nw! newfoot!=TRUE OPEN "a",#1,newname$ IF stat! PRINT #1,bord$ PRINT #1 PRINT #1,SPACE$(large%);"Total files available: ";ntotcnt% PRINT #1,SPACE$(large%);"Total file size : ";nsz%;nsz$ IF navsz%>0 PRINT #1,SPACE$(large%);"Average file length : ";navsz%;navsz$ ENDIF PRINT #1 PRINT #1,bord$ ENDIF add_footer IF ft! PRINT #1 ENDIF PRINT #1,logo$ CLOSE #1 newfoot!=FALSE ENDIF ' group_finish: IF grp_activate! @group_list_finish ENDIF ' IF EXIST(footer$) ERASE foot$() ~FRE(0) ENDIF RETURN > PROCEDURE prep_pack @clean_memory @show_mem(STR$(FRE())) @clear ' IF grp_only! GOTO move_group ENDIF ' IF EXIST(newname$)=0 nw!=FALSE ENDIF ' IF keep! copy_file(allname$) IF nw! copy_file(newname$) ENDIF ENDIF ' move_group: IF grp_activate! @group_move IF grp_only! GOTO group_pack ENDIF ENDIF ' IF lzh! lzh$="a "+arcpath$+allpack$+" "+allname$ lzh$=CHR$(LEN(lzh$))+lzh$ @clear display("Archiving "+allname$) packer(packlzh$,lzh$) ENDIF ' IF lzh! AND nw! lzh$="a "+arcpath$+newpack$+" "+newname$ lzh$=CHR$(LEN(lzh$))+lzh$ @clear display("Archiving "+newname$) packer(packlzh$,lzh$) ENDIF ' IF arc! arc$="a "+arcpath$+allpack$+" "+allname$ arc$=CHR$(LEN(arc$))+arc$ @clear display("Archiving "+allname$) packer(packarc$,arc$) ENDIF ' IF arc! AND nw! arc$="a "+arcpath$+newpack$+" "+newname$ arc$=CHR$(LEN(arc$))+arc$ @clear display("Archiving "+newname$) packer(packarc$,arc$) ENDIF ' IF zip! zip$="-a "+arcpath$+allpack$+" "+allname$ zip$=CHR$(LEN(zip$))+zip$ @clear display("Archiving "+allname$) packer(packzip$,zip$) ENDIF ' IF zip! AND nw! zip$="-a "+arcpath$+newpack$+" "+newname$ zip$=CHR$(LEN(zip$))+zip$ @clear display("Archiving "+newname$) packer(packzip$,zip$) ENDIF ' group_pack: IF grp_activate! @group_prep_pack ENDIF ' IF EXIST(allname$) KILL allname$ ENDIF IF EXIST(newname$) KILL newname$ ENDIF RETURN > PROCEDURE packer(pack$,archiver$) RESERVE 51200 ~EXEC(0,pack$,archiver$,"") RESERVE RETURN > PROCEDURE update_list1 ' IF areafsize%>=1024 asz%=INT(areafsize%/1024) sz$=" Kbytes." ELSE asz%=INT(areafsize%) sz$=" Kbytes" ENDIF ' STORE #1,title$(),tcnt% PRINT #1,"" STORE #1,info$(),cnt% IF stat! PRINT #1,"" PRINT #1,SPACE$(24);"Number of files in this area: ";cnt% PRINT #1,SPACE$(24);"Total file size: ";asz%;sz$ ENDIF PRINT #1,"" RETURN > PROCEDURE update_list2 IF nareafsize%>=1024 nsz%=INT(nareafsize%/1024) sz$=" kbytes." ELSE nsz%=INT(nareafsize%) sz$=" bytes" ENDIF STORE #1,title$(),tcnt% PRINT #1,"" STORE #1,info_new$(),cnt2% IF stat! PRINT #1,"" PRINT #1,SPACE$(24);"Number of files in this area: ";cnt2% PRINT #1,SPACE$(24);"Total file size: ";nsz%;sz$ ENDIF PRINT #1,"" RETURN > PROCEDURE cmd_line LOCAL c!,s! c!=TRUE s!=TRUE cmdl%=BYTE{BASEPAGE+&H80} cmdl$=CHAR{BASEPAGE+&H81} cmdl$=UPPER$(cmdl$) ' cmdl%=0 IF cmdl%>2 a%=INSTR(TRIM$(cmdl$)," ") IF a%=0 OR cmdl%=a% display("Must be two parameters passed on the command line. Using default") display("control files.") display("") ELSE file1$=LEFT$(cmdl$,a%-1) file2$=RIGHT$(cmdl$,cmdl%-a%) IF LEFT$(file1$,2)="-C" ctl_file$=RIGHT$(file1$,LEN(file1$)-2) c!=FALSE ELSE IF LEFT$(file1$,2)="-S" search_file$=RIGHT$(file1$,LEN(file1$)-2) s!=FALSE ENDIF IF LEFT$(file2$,2)="-C" ctl_file$=RIGHT$(file2$,LEN(file2$)-2) c!=FALSE ELSE IF LEFT$(file2$,2)="-S" search_file$=RIGHT$(file2$,LEN(file2$)-2) s!=FALSE ENDIF IF c! OR s! display("Error entering parameters. Using default control files.") display("") search_file$="SEARCH.CTL" ctl_file$="LISTER.CTL" ENDIF ENDIF ENDIF RETURN > PROCEDURE topten(desc_cnt$,fname$) fnum%=0 IF LEFT$(desc_cnt$,1)=bracket1$ a|=INSTR(desc_cnt$,bracket2$) IF a|>0 fnum$=MID$(desc_cnt$,2,a|-2) fnum%=VAL(fnum$) IF fnum%>0 FOR ix%=0 TO tp%-1 IF top%(ix%)<fnum% INSERT top%(ix%)=fnum% INSERT top$(ix%)=fname$ INSERT topsize$(ix%)=fsize$(j%) INSERT topdesc$(ix%)=MID$(fldesc$,INSTR(fldesc$,bracket2$)+2,36) IF tc%<tp%-1 INC tc% ENDIF mv!=TRUE EXIT IF mv! ENDIF NEXT ix% mv!=FALSE ENDIF ENDIF ENDIF RETURN > PROCEDURE pro_topten(fname$,fnum%) IF fnum%>0 FOR ix%=0 TO tp%-1 IF top%(ix%)<fnum% INSERT top%(ix%)=fnum% INSERT top$(ix%)=fname$ INSERT topsize$(ix%)=fsize$(j%) INSERT topdesc$(ix%)=LEFT$(fldesc$,36) IF tc%<tp%-1 INC tc% ENDIF mv!=TRUE EXIT IF mv! ENDIF NEXT ix% mv!=FALSE ENDIF RETURN > PROCEDURE make_date(fdate%) IF fdate%>today% OR fdate%<33 @logit("Filedate for "+fname$(j%)+" out of range!") IF fixdate! OPEN "u",#3,path$+fname$(j%) TOUCH #3 CLOSE #3 @logit(path$+fname$(j%)+" has had date fixed.") ELSE @logit("File will be given today's date in the allfiles lists.") ENDIF fdate%=today% ENDIF day%=fdate% AND &X11111 fdate%=SHR(fdate%,5) mth%=fdate% AND &X1111 fdate%=SHR(fdate%,4) yr%=(fdate% AND &X1111111)+1980 day$=STR$(day%,2) mth$=STR$(mth%,2) IF day%<10 MID$(day$,1)="0" ENDIF IF mth%<10 MID$(mth$,1)="0" ENDIF fdate$=day$+"/"+mth$+"/"+RIGHT$(STR$(yr%,4),2) RETURN ' ' Miscellaneous general routines ' > PROCEDURE display(show$) IF lc%<25 PRINT AT(1,lc%);show$ ELSE PRINT AT(1,6);"M" PRINT AT(1,24);show$ ENDIF INC lc% RETURN > PROCEDURE show_mem(mem$) IF smem! PRINT AT(55,5);"Free memory "+mem$+" bytes." ENDIF RETURN > PROCEDURE took_how_long @clear time%=(TIMER-t%)/200 WHILE time%>59 INC minute% time%=time%-60 WEND IF time%=1 sec$="second" ELSE sec$="seconds" ENDIF IF minute%=1 display("") display("List took "+STR$(minute%)+" minute "+STR$(time%)+" "+sec$+" to compile.") ELSE IF minute%>1 display("") display("List took "+STR$(minute%)+" minutes "+STR$(time%)+" "+sec$+" to compile.") ELSE display("") display("List took "+STR$(time%)+" "+sec$+" to compile.") ENDIF PAUSE 50 RETURN > PROCEDURE omit_files INC c% WHILE LEFT$(lster$(c%),7)<>"ENDOMIT" IF LEFT$(lster$(c%),1)<>";" omitfile$=omitfile$+TRIM$(lster$(c%)) ENDIF INC c% WEND RETURN > PROCEDURE copy_file(copy$) IF arcpath$<>origpath$ display("Copying "+copy$+" to "+arcpath$+copy$) OPEN "i",#1,copy$ OPEN "o",#2,arcpath$+copy$ l%=LOF(#1) WHILE l%>32000 PRINT #2,INPUT$(32000,#1); SUB l%,32000 WEND PRINT #2,INPUT$(l%,#1); CLOSE #1 CLOSE #2 ENDIF RETURN > PROCEDURE clear PRINT AT(1,6);"J" lc%=6 RETURN > PROCEDURE clean_memory ERASE numareas%(),top%(),top$(),topsize$(),topdesc$() ~FRE(0) RETURN > PROCEDURE g_clean_memory ERASE g_top%(),g_top$(),g_topsize$(),g_topdesc$() ~FRE(0) RETURN > PROCEDURE backslash(VAR backslash$) IF RIGHT$(backslash$)<>"\" backslash$=backslash$+"\" ENDIF RETURN > PROCEDURE logit(log$) IF logit! IF EXIST(logpath$) OPEN "a",#2,logpath$ ELSE MODE 3 OPEN "o",#2,logpath$ PRINT #2,"--------------------------------------------------" PRINT #2,"LiSTer "+version$+" Log - Created on "+MID$(DATE$,4,3)+LEFT$(DATE$,3)+RIGHT$(DATE$,2)+" at "+TIME$ PRINT #2,"--------------------------------------------------" PRINT #2 ENDIF PRINT #2,log$ CLOSE #2 ENDIF RETURN > PROCEDURE debug(debug$) ' debug$ is limited to 68 characters. OPEN "a",#2,dblog$ MODE 3 IF blank! PRINT #2 ENDIF PRINT #2,MID$(DATE$,4,3)+LEFT$(DATE$,2)+" "+LEFT$(TIME$,5)+" "+debug$ CLOSE #2 RETURN > PROCEDURE error_trapping display(ERR$(ERR)) IF FATAL=FALSE IF ERR=37 AND drv$=l_drv$ GOTO escape_clause ELSE logit!=TRUE logit(ERR$(ERR)) ENDIF ENDIF escape_clause: finish(ERR) RETURN > PROCEDURE breakout finish(0) RETURN > PROCEDURE finish(f%) CLEAR SHOWM ~FRE(0) EDIT QUIT f% RETURN > FUNCTION fullpath$(d$) LOCAL cwd$,ret$ cwd$=CHR$(ASC("A")+GEMDOS(25))+":"+DIR$(0) IF MID$(d$,2,1)=":" IF (BIOS(10) AND 2^(ASC(UPPER$(d$))-65))=0 logit!=-1 logit("!Drive "+LEFT$(d$)+" doesn't exist!") QUIT 1 ENDIF CHDRIVE d$ d$=MID$(d$,3) ENDIF IF LEFT$(d$)="\" CHDIR "\" d$=MID$(d$,2) ENDIF DO WHILE d$>"" IF INSTR(d$,"\") c$=LEFT$(d$,INSTR(d$,"\")-1) d$=MID$(d$,INSTR(d$,"\")+1) ELSE c$=d$ d$="" ENDIF IF FSFIRST(c$,16) AND c$<>"." MKDIR c$ ENDIF CHDIR c$ LOOP ret$=CHR$(ASC("A")+GEMDOS(25))+":"+DIR$(0) CHDRIVE cwd$ CHDIR cwd$ RETURN ret$+"\" ENDFUNC ' ' Group handling operations ' > PROCEDURE group_data group$(grp%)=RIGHT$(lster$(c%),1) INC c% REPEAT ' IF LEFT$(UPPER$(lster$(c%)),7)="ALLNAME" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_allname$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) IF INSTR(RIGHT$(g_allname$(grp%),4),".")=0 g_allpack$(grp%)=g_allname$(grp%) g_allname$(grp%)=g_allpack$(grp%)+".TXT" ELSE g_allpack$(grp%)=LEFT$(g_allname$(grp%),INSTR(g_allname$(grp%),".")-1) ENDIF ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="NEWNAME" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_newname$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) IF INSTR(RIGHT$(g_newname$(grp%),4),".")=0 g_newpack$(grp%)=g_newname$(grp%) g_newname$(grp%)=g_newpack$(grp%)+".TXT" ELSE g_newpack$(grp%)=LEFT$(g_newname$(grp%),INSTR(g_newname$(grp%),".")-1) ENDIF gnw!(grp%)=TRUE ' Make a Newfiles list too. ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="KEEPPATH" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_arcpath$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) IF RIGHT$(g_arcpath$(grp%),1)<>"\" g_arcpath$(grp%)=g_arcpath$(grp%)+"\" ENDIF g_allfile$(grp%)=g_arcpath$(grp%)+g_allname$(grp%) g_newfile$(grp%)=g_arcpath$(grp%)+g_newname$(grp%) ' This is where the lists are saved. ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="KEEPLIST" keep!(grp%)=TRUE ' Don't delete the ascii lists! ENDIF ' IF LEFT$(UPPER$(lster$(c%)),6)="HEADER" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_header$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),9)="NEWHEADER" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_newheader$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) newhead!(grp%)=TRUE ENDIF ' IF LEFT$(UPPER$(lster$(c%)),5)="MAGIC" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND g_magic$(grp%)=UPPER$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1)) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="ARCLIST" arc!(grp%)=TRUE ' ARC the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="LZHLIST" lzh!(grp%)=TRUE ' LZH the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="ZIPLIST" zip!(grp%)=TRUE ' ZIP the allfiles list(s) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="TOPTEN" tt!(grp%)=TRUE gtp%(grp%)=10 ' Include Top Ten list to Allfiles list. ENDIF ' IF LEFT$(UPPER$(lster$(c%)),8)="TOPTITLE" a%=INSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND toptitle$(grp%)=TRIM$(LEFT$(MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1),74)) ENDIF ' IF LEFT$(UPPER$(lster$(c%)),7)="LISTTOP" a%=INSTR(lster$(c%),"$") gtp%(grp%)=VAL(MID$(lster$(c%),a%+1,LEN(lster$(c%))-a%)) ' IF gtp%(grp%)=0 gtp%(grp%)=10 ENDIF ' IF gtp%(grp%)>50 gtp%(grp%)=50 ENDIF ' ENDIF ' IF LEFT$(UPPER$(lster$(c%)),12)="WRITE TOPTEN" a%=RINSTR(lster$(c%)," ") WHILE MID$(lster$(c%),a%,1)=" " INC a% WEND outtp$(grp%)=MID$(lster$(c%),a%,LEN(lster$(c%))-a%+1) ' IF RIGHT$(outtp$(grp%),1)<>"\" outtp$(grp%)=outtp$(grp%)+"\" ENDIF ' outtp$(grp%)=outtp$(grp%)+"TOP_"+STR$(gtp%(grp%))+"_"+group$(grp%) IF tt!(grp%) otp!(grp%)=TRUE ENDIF ENDIF ' INC c% UNTIL LEFT$(UPPER$(lster$(c%)),8)="GROUPEND" OR c%=n% INC grp% grp_activate!=TRUE RETURN > PROCEDURE group_headers FOR i%=0 TO grp%-1 IF EXIST(g_header$(i%)) DIM g_head$(300) OPEN "i",#1,g_header$(i%) RECALL #1,g_head$(),-1,hdr% CLOSE #1 OPEN "o",#1,g_allname$(i%) STORE #1,g_head$(),hdr% CLOSE #1 ENDIF ' IF newhead!(i%) AND gnw!(i%) IF EXIST(g_newheader$(i%)) DIM g_newhead$(300) OPEN "i",#1,g_newheader$(i%) RECALL #1,g_newhead$(),-1,hdr% CLOSE #1 nh!(i%)=TRUE !Alternative header file for newfiles list. ENDIF ENDIF ' IF gnw!(i%) OPEN "O",#1,g_newname$(i%) IF nh!(i%) STORE #1,g_newhead$(),hdr% ELSE STORE #1,g_head$(),hdr% ENDIF CLOSE #1 ENDIF ' ERASE g_head$(),g_newhead$() ~FRE(0) NEXT i% RETURN > PROCEDURE group_magics FOR i%=0 TO grp%-1 IF EXIST(g_magic$(i%)) DIM gmagic$(300) OPEN "i",#1,g_magic$(i%) RECALL #1,gmagic$(),-1,mag2% CLOSE #1 ENDIF ' IF EXIST(g_allname$(i%)) OPEN "a",#1,g_allname$(i%) STORE #1,gmagic$(),mag2% CLOSE #1 ELSE OPEN "o",#1,g_allname$(i%) STORE #1,gmagic$(),mag2% CLOSE #1 ENDIF ' IF gnw!(i%) IF EXIST(g_newname$(i%)) OPEN "a",#1,g_newname$(i%) STORE #1,gmagic$(),mag2% CLOSE #1 ELSE OPEN "o",#1,g_newname$(i%) STORE #1,gmagic$(),mag2% CLOSE #1 ENDIF ENDIF ' ERASE gmagic$() ~FRE(0) NEXT i% RETURN > PROCEDURE group_output_file_lists IF grn! make_date(GEMDOS(42)) FOR i%=0 TO grp%-1 IF EXIST(g_allname$(i%)) OPEN "a",#1,g_allname$(i%) ELSE OPEN "o",#1,g_allname$(i%) ENDIF PRINT #1,"List created : ";fdate$ PRINT #1,"Files marked with a '*' are new in the last ";STR$(numdays%);" days." PRINT #1,"" CLOSE #1 NEXT i% grn!=FALSE ENDIF ' FOR i%=0 TO grp%-1 IF INSTR(group$,group$(i%))>0 IF EXIST(g_allname$(i%)) OPEN "a",#1,g_allname$(i%) update_list1 CLOSE #1 INC numareas%(i%) mt%(i%)=mt%(i%)+md%+mf% totcnt%(i%)=totcnt%(i%)+cnt% totfilesize%(i%)=totfilesize%(i%)+areafsize% ENDIF IF cnt2%>0 IF EXIST(g_newname$(i%)) OPEN "a",#1,g_newname$(i%) update_list2 CLOSE #1 ntotcnt%(i%)=ntotcnt%(i%)+cnt2% totnfilesize%(i%)=totnfilesize%(i%)+nareafsize% ENDIF ENDIF ENDIF NEXT i% RETURN > PROCEDURE group_list_finish FOR i%=0 TO grp%-1 asz%=0 nsz%=0 avsz%=0 navsz%=0 asz$="" nsz$="" avsz$="" navsz$="" ' IF totfilesize%(i%)>=1024 asz%=INT(totfilesize%(i%)/1024) asz$=" Kbytes." ' ELSE asz%=INT(totfilesize%(i%)) asz$=" bytes" ENDIF ' IF totcnt%(i%)>0 avsz%=INT(totfilesize%(i%)/totcnt%(i%)) IF avsz%>=1024 avsz%=avsz%/1024 avsz$=" Kbytes." ELSE avsz$=" bytes." ENDIF ENDIF ' IF totnfilesize%(i%)>=1024 nsz%=INT(totnfilesize%(i%)/1024) nsz$=" Kbytes." ELSE nsz%=INT(totnfilesize%(i%)) nsz$=" bytes" ENDIF ' IF ntotcnt%(i%)>0 navsz%=INT(totnfilesize%(i%)/ntotcnt%(i%)) IF navsz%>=1024 navsz%=navsz%/1024 navsz$=" Kbytes." ELSE navsz$=" bytes." ENDIF ENDIF ' large$="Largest file is "+g_bigfile$(i%)+" at "+STR$(g_max%(i%))+" bytes." small$="Smallest file is "+g_smallfile$(i%)+" at "+STR$(g_min%(i%))+" bytes." large%=(80-LEN(large$))/2 large$=SPACE$(large%)+large$ small$=SPACE$(large%)+small$ ' IF EXIST(g_allname$(i%)) all!=TRUE OPEN "a",#1,g_allname$(i%) IF stat! PRINT #1,bord$ PRINT #1 PRINT #1,SPACE$(pad%);"Total files available: ";totcnt%(i%) PRINT #1,SPACE$(pad%);"Total file size : ";asz%;asz$ PRINT #1,SPACE$(pad%);"Number of areas : ";numareas%(i%) IF avsz%>0 PRINT #1,SPACE$(pad%);"Average file length : ";avsz%;avsz$ ENDIF IF mi! PRINT #1,SPACE$(pad%);"Descriptions missing : ";mt%(i%) ENDIF PRINT #1 PRINT #1,large$ PRINT #1,small$ IF tt!(i%) PRINT #1 PRINT #1,SPACE$(16);"Top ";STR$(gtp%(i%));" most popular files on this system are..." PRINT #1 PRINT #1,SPACE$(20);"Position Filename Number of d/l's" PRINT #1 FOR l%=0 TO tc%(i%) IF g_top$(l%,i%)="" GOTO no_name ENDIF LSET fttop$=g_top$(l%,i%) PRINT #1,SPACE$(19);STR$(l%+1,6);". ";fttop$;" ";STR$(g_top%(l%,i%),6) no_name: NEXT l% PRINT #1 ENDIF PRINT #1,bord$ ENDIF add_footer IF ft! PRINT #1 ENDIF PRINT #1,logo$ CLOSE #1 all!=FALSE ENDIF ' IF otp!(i%) IF fourtops! tx%=3 ELSE tx%=0 ENDIF ' FOR b%=0 TO tx% ' IF b%=0 ! Straight ASCII output ext$=".ASC" ELSE IF b%=1 ! Mono output ext$=".VTM" ELSE IF b%=2 ! Colour output ext$=".VTC" ELSE ext$=".ANS" ! ANSI output ENDIF ' hdl$=" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" No. "+bc$(b%)+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Filename "+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+" Size "+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%)+br$(b%)+" DL'd "+bc$(b%)+g$(b%)+be$(b%)+b$(b%) hdl$=hdl$+" "+br$(b%)+" Description "+bc$(b%)+SPACE$(24)+g$(b%)+be$(b%)+b$(b%) tsepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bts$(b%)+STRING$(14,bse$(b%))+bts$(b%)+STRING$(9,bse$(b%))+bts$(b%)+STRING$(6,bse$(b%))+bts$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%) sepl$=" "+g$(b%)+besl$(b%)+STRING$(5,bse$(b%))+bcs$(b%)+STRING$(14,bse$(b%))+bcs$(b%)+STRING$(9,bse$(b%))+bcs$(b%)+STRING$(6,bse$(b%))+bcs$(b%)+STRING$(38,bse$(b%))+besr$(b%)+b$(b%) ' IF toptitle$(i%)="" topadd$=SPACE$(11)+"The Top "+STR$(gtp%(i%),2)+" Chart - created on "+DATE$+" at "+TIME$+SPACE$(11) ELSE IF LEN(toptitle$(i%)) MOD 2=1 padit|=1 ELSE padit|=0 ENDIF spc%=(74-LEN(toptitle$))/2 spc2%=spc%+padit| topadd$=SPACE$(spc%)+toptitle$(i%)+SPACE$(spc2%) ENDIF topper$=" "+g$(b%)+be$(b%)+b$(b%)+" "+br$(b%)+topadd$+bc$(b%)+" "+g$(b%)+be$(b%)+b$(b%) ' display("Writing "+outtp$(i%)+ext$) OPEN "o",#1,outtp$(i%)+ext$ PRINT #1," ";g$(b%);btl$(b%);STRING$(76,bse$(b%));btr$(b%);b$(b%) PRINT #1,topper$ PRINT #1,tsepl$ PRINT #1,hdl$ PRINT #1,sepl$ FOR l%=0 TO tc%(i%) IF g_top$(l%,i%)="" GOTO no_name2 ENDIF LSET fttop$=g_top$(l%,i%) RSET ftsize$=g_topsize$(l%,i%) LSET ftdesc$=g_topdesc$(l%,i%) PRINT #1," ";g$(b%);be$(b%);r$(b%);STR$(l%+1,3);". ";g$(b%);be$(b%);b$(b%);" ";fttop$;g$(b%);be$(b%);" ";r$(b%);ftsize$;b$(b%);" ";g$(b%);be$(b%);" ";r$(b%);STR$(g_top%(l%,i%),4);g$(b%);" ";be$(b%);b$(b%);" ";ftdesc$;" ";g$(b%);be$(b%);b$(b%) no_name2: NEXT l% PRINT #1," ";g$(b%);besl$(b%);STRING$(5,bse$(b%));bbs$(b%);STRING$(14,bse$(b%));bbs$(b%);STRING$(9,bse$(b%));bbs$(b%);STRING$(6,bse$(b%));bbs$(b%);STRING$(38,bse$(b%));besr$(b%);b$(b%) PRINT #1," ";g$(b%);be$(b%);b$(b%);SPACE$(6);"Top ";STR$(gtp%(i%),2);" produced by ";br$(b%);" LiSTer V";version$;" ";bc$(b%);" (c)1993/94 by Robert Darling.";SPACE$(7);g$(b%);be$(b%);b$(b%) PRINT #1," ";g$(b%);bbl$(b%);STRING$(76,bse$(b%));bbr$(b%);b$(b%) ' CLOSE #1 NEXT b% ENDIF ' ' IF EXIST(g_newname$(i%)) AND gnw!(i%) newfoot!=TRUE OPEN "a",#1,g_newname$(i%) IF stat! PRINT #1,bord$ PRINT #1 PRINT #1,SPACE$(large%);"Total files available: ";ntotcnt%(i%) PRINT #1,SPACE$(large%);"Total file size : ";nsz%;nsz$ IF navsz%>0 PRINT #1,SPACE$(large%);"Average file length : ";navsz%;navsz$ ENDIF PRINT #1 PRINT #1,bord$ ENDIF add_footer IF ft! PRINT #1 ENDIF PRINT #1,logo$ CLOSE #1 newfoot!=FALSE ENDIF NEXT i% RETURN > PROCEDURE group_move FOR i%=0 TO grp%-1 IF EXIST(g_newname$(i%))=0 gnw!(i%)=FALSE ENDIF IF keep!(i%) group_copy_file(g_allname$(i%)) IF gnw!(i%) group_copy_file(g_newname$(i%)) ENDIF ENDIF NEXT i% RETURN > PROCEDURE group_prep_pack @g_clean_memory @show_mem(STR$(FRE())) ' FOR i%=0 TO grp%-1 IF lzh!(i%) lzh$="a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%) lzh$=CHR$(LEN(lzh$))+lzh$ @clear display("Archiving "+g_allname$(i%)) packer(packlzh$,lzh$) ENDIF IF lzh!(i%) AND gnw!(i%) lzh$="a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%) lzh$=CHR$(LEN(lzh$))+lzh$ @clear display("Archiving "+g_newname$(i%)) packer(packlzh$,lzh$) ENDIF IF arc!(i%) arc$="a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%) arc$=CHR$(LEN(arc$))+arc$ @clear display("Archiving "+g_allname$(i%)) packer(packarc$,arc$) ENDIF IF arc!(i%) AND gnw!(i%) arc$="a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%) arc$=CHR$(LEN(arc$))+arc$ @clear display("Archiving "+g_newname$(i%)) packer(packarc$,arc$) ENDIF IF zip!(i%) zip$="-a "+g_arcpath$(i%)+g_allpack$(i%)+" "+g_allname$(i%) zip$=CHR$(LEN(zip$))+zip$ @clear display("Archiving "+g_allname$(i%)) packer(packzip$,zip$) ENDIF IF zip!(i%) AND gnw!(i%) zip$="-a "+g_arcpath$(i%)+g_newpack$(i%)+" "+g_newname$(i%) zip$=CHR$(LEN(zip$))+zip$ @clear display("Archiving "+g_newname$(i%)) packer(packzip$,zip$) ENDIF NEXT i% ' FOR i%=0 TO grp%-1 IF EXIST(g_allname$(i%)) KILL g_allname$(i%) ENDIF IF EXIST(g_newname$(i%)) KILL g_newname$(i%) ENDIF NEXT i% RETURN > PROCEDURE group_copy_file(copy$) IF g_arcpath$(i%)<>origpath$ display("Copying "+copy$+" to "+g_arcpath$(i%)+copy$) OPEN "i",#1,copy$ OPEN "o",#2,g_arcpath$(i%)+copy$ l%=LOF(#1) WHILE l%>32000 PRINT #2,INPUT$(32000,#1); SUB l%,32000 WEND PRINT #2,INPUT$(l%,#1); CLOSE #1 CLOSE #2 ENDIF RETURN > PROCEDURE group_topten ' FOR jj%=0 TO grp%-1 ! Got to cover all groups ' IF INSTR(group$,group$(jj%))=0 GOTO next_group ENDIF ' IF tt!(jj%) ! But only create top 10 for those asked for... ' FOR kk%=0 TO gtp%(jj%)-1 ! Position checking! ' IF g_top%(kk%,jj%)<fnum% ! Only works if d/l count is ' ! higher than any others. ' IF tc%(jj%)>0 ! Only as many as needed!!! FOR xx%=tc%(jj%) TO kk%+1 STEP -1 ! Have to manually move array g_top%(xx%,jj%)=g_top%(xx%-1,jj%) ! elements up as INSERT command g_top$(xx%,jj%)=g_top$(xx%-1,jj%) ! only works with single g_topsize$(xx%,jj%)=g_topsize$(xx%-1,jj%) g_topdesc$(xx%,jj%)=g_topdesc$(xx%-1,jj%) NEXT xx% ! dimension arrays. ENDIF ' g_top%(kk%,jj%)=fnum% ! Insert new data.... g_top$(kk%,jj%)=fname$ g_topsize$(kk%,jj%)=fsize$(j%) IF probbs! g_topdesc$(kk%,jj%)=LEFT$(fldesc$,36) ELSE g_topdesc$(kk%,jj%)=MID$(fldesc$,(INSTR(fldesc$,bracket2$)+2),36) ENDIF ' IF tc%(jj%)<gtp%(jj%)-1 ! Keep a tab on postion count. INC tc%(jj%) ! we only want top ten. *8) ENDIF ' mv!(jj%)=TRUE ! No point in going around again. EXIT IF mv!(jj%) ! Got info so exit loop. ' ENDIF NEXT kk% ' mv!(jj%)=FALSE ! Reset for next time. ENDIF ' next_group: NEXT jj% RETURN > PROCEDURE g_bigfile(g_big$,g_max%) FOR i%=0 TO grp%-1 IF INSTR(group$,group$(i%))>0 IF g_bigfile$(i%)<>g_big$ g_bigfile$(i%)=g_big$ g_max%(i%)=g_max% ENDIF ENDIF NEXT i% RETURN > PROCEDURE g_smallfile(g_small$,g_min%) FOR i%=0 TO grp%-1 IF INSTR(group$,group$(i%))>0 IF g_smallfile$(i%)<>g_small$ g_smallfile$(i%)=g_small$ g_min%(i%)=g_min% ENDIF ENDIF NEXT i% RETURN